home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_Tix.idb / usr / freeware / lib / tix4.1 / NoteBook.tcl.z / NoteBook.tcl
Encoding:
Text File  |  1999-01-26  |  5.8 KB  |  244 lines
  1. # NoteBook.tcl --
  2. #
  3. #    tixNoteBook: NoteBook type of window.
  4. #
  5. # Copyright (c) 1996, Expert Interface Technologies
  6. #
  7. # See the file "license.terms" for information on usage and redistribution
  8. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  9. #
  10.  
  11. tixWidgetClass tixNoteBook {
  12.     -classname TixNoteBook
  13.     -superclass tixVStack
  14.     -method {
  15.     }
  16.     -flag {
  17.     }
  18.     -configspec {
  19.     {-takefocus takeFocus TakeFocus 0 tixVerifyBoolean} 
  20.     }
  21.     -default {
  22.     {.Background        #d9d9d9}
  23.     {.nbframe.tabPadX    8}
  24.     {.nbframe.tabPadY    5}
  25.     {.nbframe.borderWidth    2}
  26.     {.nbframe.Background    #d9d9d9}
  27.     {*nbframe.relief    raised}
  28.     {*nbframe.font        -Adobe-Helvetica-Bold-R-Normal--*-120-*}
  29.     {.nbframe.inactiveBackground    #c3c3c3}
  30.     }
  31. }
  32.  
  33. proc tixNoteBook:InitWidgetRec {w} {
  34.     upvar #0 $w data
  35.  
  36.     tixChainMethod $w InitWidgetRec
  37.  
  38.     set data(pad-x1) 0
  39.     set data(pad-x2) 0
  40.     set data(pad-y1) 20
  41.     set data(pad-y2) 0
  42. }
  43.  
  44. proc tixNoteBook:ConstructWidget {w} {
  45.     upvar #0 $w data
  46.  
  47.     tixChainMethod $w ConstructWidget
  48.     
  49.     set data(w:top) [tixNoteBookFrame $w.nbframe -slave 1 -takefocus 1]
  50.     set data(w:nbframe) $data(w:top)
  51.  
  52.     bind $data(w:top) <ButtonPress-1> "tixNoteBook:MouseDown $w %x %y"
  53.     bind $data(w:top) <ButtonRelease-1> "tixNoteBook:MouseUp $w %x %y"
  54.  
  55.     bind $data(w:top) <B1-Motion> "tixNoteBook:MouseDown $w %x %y"
  56.  
  57.     bind $data(w:top) <Left>  "tixNoteBook:FocusNext $w prev"
  58.     bind $data(w:top) <Right> "tixNoteBook:FocusNext $w next"
  59.  
  60.     bind $data(w:top) <Return> "tixNoteBook:SetFocusByKey $w"
  61.     bind $data(w:top) <space>  "tixNoteBook:SetFocusByKey $w"
  62. }
  63.  
  64. #----------------------------------------------------------------------
  65. # Public methods
  66. #----------------------------------------------------------------------
  67. proc tixNoteBook:add {w child args} {
  68.     upvar #0 $w data
  69.  
  70.     set ret [eval tixChainMethod $w add $child $args]
  71.  
  72.     set new_args ""
  73.     tixForEach {flag value} $args {
  74.     if {$flag != "-createcmd" && $flag != "-raisecmd"} {
  75.         lappend new_args $flag
  76.         lappend new_args $value
  77.     }
  78.     }
  79.  
  80.     eval $data(w:top) add $child $new_args
  81.  
  82.     return $ret
  83. }
  84.  
  85. proc tixNoteBook:raise {w child} {
  86.     upvar #0 $w data
  87.  
  88.     tixChainMethod $w raise $child
  89.  
  90.     if {[$data(w:top) pagecget $child -state] == "normal"} {
  91.     $data(w:top) activate $child
  92.     }
  93. }
  94.  
  95. proc tixNoteBook:delete {w child} {
  96.     upvar #0 $w data
  97.  
  98.     tixChainMethod $w delete $child
  99.     $data(w:top) delete $child
  100. }
  101.  
  102. #----------------------------------------------------------------------
  103. # Private methods
  104. #----------------------------------------------------------------------
  105. proc tixNoteBook:Resize {w} {
  106.     upvar #0 $w data
  107.  
  108.     # We have to take care of the size of the tabs so that 
  109.     #
  110.     set rootReq [$data(w:top) geometryinfo]
  111.     set tW [lindex $rootReq 0]
  112.     set tH [lindex $rootReq 1]
  113.  
  114.     set data(pad-x1) 2 
  115.     set data(pad-x2) 2
  116.     set data(pad-y1) [expr $tH + $data(-ipadx) + 1]
  117.     set data(pad-y2) 2
  118.     set data(minW)   [expr $tW]
  119.     set data(minH)   [expr $tH]
  120.  
  121.     # Now that we know data(pad-y1), we can chain the call
  122.     #
  123.     tixChainMethod $w Resize
  124. }
  125.  
  126. proc tixNoteBook:MouseDown {w x y} {
  127.     upvar #0 $w data
  128.  
  129.     focus $data(w:top)
  130.  
  131.     set name [$data(w:top) identify $x $y]
  132.     $data(w:top) focus $name
  133.     set data(w:down) $name
  134. }
  135.  
  136. proc tixNoteBook:MouseUp {w x y} {
  137.     upvar #0 $w data
  138.  
  139.     set name [$data(w:top) identify $x $y]
  140.  
  141.     if {$name != "" && $name == $data(w:down) && [$data(w:top) pagecget $name -state] == "normal" } {
  142.         $data(w:top) activate $name
  143.         tixCallMethod $w raise $name
  144.     } else {
  145.         $data(w:top) focus ""
  146.     }
  147. }
  148.  
  149.  
  150. #----------------------------------------------------------------------
  151. #
  152. # Section for keyboard bindings
  153. #
  154. #----------------------------------------------------------------------
  155.  
  156. proc tixNoteBook:FocusNext {w dir} {
  157.     upvar #0 $w data
  158.  
  159.     if {[$data(w:top) info focus] == ""} {
  160.     set name [$data(w:top) info active]
  161.     $data(w:top) focus $name
  162.  
  163.     if {$name != ""} {
  164.         return
  165.     }
  166.     } else {
  167.     set name [$data(w:top) info focus$dir]
  168.      $data(w:top) focus $name
  169.    }
  170. }
  171.  
  172. proc tixNoteBook:SetFocusByKey {w} {
  173.     upvar #0 $w data
  174.  
  175.     set name [$data(w:top) info focus]
  176.  
  177.     if {$name != "" && [$data(w:top) pagecget $name -state] == "normal"} {
  178.     tixCallMethod $w raise $name
  179.     $data(w:top) activate $name
  180.     }
  181. }
  182.  
  183. #----------------------------------------------------------------------
  184. # Automatic bindings for alt keys
  185. #----------------------------------------------------------------------
  186. proc tixNoteBookFind {w char} {
  187.     global tkPriv
  188.     set char [string tolower $char]
  189.  
  190.     foreach child [winfo child $w] {
  191.     if {![winfo ismapped $w]} {
  192.         continue
  193.     }
  194.     switch [winfo class $child] {
  195.         {Toplevel} {
  196.         continue
  197.         }
  198.         TixNoteBook {
  199.         set nbframe [$child subwidget nbframe]
  200.         foreach page [$nbframe info pages] {
  201.             set char2 [string index [$nbframe pagecget $page -label] \
  202.             [$nbframe pagecget $page -underline]]
  203.             if {([string compare $char [string tolower $char2]] == 0)||
  204.             ($char == "")} {
  205.             if {[$nbframe pagecget $page -state] != "disabled"} {
  206.                 return "$child $page"
  207.             }
  208.             }
  209.         }
  210.         }
  211.     }
  212.     # Well, this notebook doesn't match with the key, but maybe
  213.     # it contains a "subnotebook" that will match ..
  214.     set match [tixNoteBookFind $child $char]
  215.     if {$match != ""} {
  216.         return $match
  217.     }
  218.     }
  219.     return ""
  220. }
  221.  
  222. proc tixTraverseToNoteBook {w char} {
  223.     if {$char == ""} {
  224.     return 0
  225.     }
  226.     if {![winfo exists $w]} {
  227.     return 0
  228.     }
  229.     set list [tixNoteBookFind [winfo toplevel $w] $char]
  230.     if {$list != ""} {
  231.     [lindex $list 0] raise [lindex $list 1]
  232.     return 1
  233.     }
  234.     return 0
  235. }
  236.  
  237. #----------------------------------------------------------------------
  238. # Set default class bindings
  239. #----------------------------------------------------------------------
  240.  
  241. bind all <Alt-KeyPress> "+tixTraverseToNoteBook %W %A"
  242. bind all <Meta-KeyPress> "+tixTraverseToNoteBook %W %A"
  243.  
  244.